perm filename PIX.SAI[CMS,LCS]1 blob sn#108356 filedate 1974-06-27 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "SLAVE"
C00004 00003	SUBR PULP
C00008 00004	SUBR WAVE
C00012 ENDMK
C⊗;
BEGIN "SLAVE"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
	DEFINE α="COMMENT";
	DEFINE π="3.1415927";
	DEFINE SUBR="SIMPLE PROCEDURE";
	DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
	DEFINE THRU="STEP 1 UNTIL";
	DEFINE ⊂="BEGIN";
	DEFINE ⊃="END";

	INTEGER BOY,MAN,HD,RA,LA,RS,LS,RH,LH,LP;
	INTEGER RT,LT,RL,LL,RF,LF,LC,DOWN,UP,IP;
	REAL TA,BM,DG,DB,RB,BA,RN;
SUBR INIT;	α INITIALIZATION;
BEGIN "INIT"
	MKUNIV;GEODPY;
	BOY←INB3D("SKY[CMS,LCS]");
	MAN←FDNAME("GIRL");
	HD←FDNAME("HD");
	RA←FDNAME("RA");
	LA←FDNAME("LA");
	RL←FDNAME("RL");
	LL←FDNAME("LL");
	RF←FDNAME("RF");
	LF←FDNAME("LF");
	RS←FDNAME("RS");
	LS←FDNAME("LS");
	RT←FDNAME("RT");
	LT←FDNAME("LT");
	RH←FDNAME("RH");
	LH←FDNAME("LH");
	GEODPY;LC ← INCHRW;
	IF LC="P" THEN BEGIN
	IP ← IP+1;OUTSTR("FRAME "&CVS(IP));
	PLOTO("JOAN."&CVS(IP));LP ← -1;⊃;
END "INIT";



SUBR PULP;
BEGIN "PULP"
	IF LP<0 THEN BEGIN IP ← IP+1;SHOW2(0,1);
	OUTSTR("FRAME "&CVS(IP));PLOTO("JOAN."&CVS(IP));
	RETURN;⊃;
	GEODPY;
	RETURN;
END "PULP";
SUBR NOD;
BEGIN "NOD"
	INTEGER I,L;
	RN ← -RN;
	FOR L←1 THRU 2 DO
	⊂ RN ← -RN;
	  FOR I←1 THRU 4 DO
	  ⊂ ROTATE(-HD,0,RN,0);PULP;⊃;⊃;
	RETURN;
END "NOD";
SUBR BEND(INTEGER ID);
BEGIN "BEND"
	INTEGER I;
	 IF ID≥0 THEN ⊂ DB ← -DB;RB ← -RB;BA ← -BA;⊃;
	 FOR I←1 THRU 3 DO
	 ⊂ ROTATE(-MAN,DB,0,0);ROTATE(-LT,DB,0,0);
	   TRANSL(-MAN,0,RB,BA);ROTATE(-RT,-DB,0,0);
	   PULP;⊃;
	 IF ID≥0 THEN ⊂ DB ← -DB;RB ← -RB;BA ← -BA;⊃;
	RETURN;
END "BEND";
SUBR ARMS;
BEGIN "ARMS"
	INTEGER K;
	FOR K←1 THRU 4 DO
	⊂ ROTATE(-RA,-BM,0,0);ROTATE(-LA,BM,0,0);PULP;⊃;
	BM ← -BM;RETURN;
END "ARMS";
SUBR ROND;
BEGIN "ROND"
	TA ← -TA;
WHILE TRUE DO
	⊂ ROTATE(-MAN,0,TA,0);PULP;
	LC ← INCHRS;
	IF LC≥0 THEN RETURN;⊃;
END "ROND";
SUBR WALK;
BEGIN "WALK"
	INTEGER I;
	REAL DW,DQ,DF,DK;
	DK ← π*4/180;
	DF ← -.07;
	DW ← π*8/180;
	DQ ← π*7/180;
BEGIN "STAR"
	ARMS;
	FOR I←1 THRU 5 DO 
	⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
	  ROTATE(-RL,DK,0,0);ROTATE(-LL,-DK,0,0);
	  ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);
	  ROTATE(-HD,0,-DW,0);TRANSL(-MAN,0,DF,.47);PULP;⊃;
WHILE TRUE DO
BEGIN "FOREVER"
	INTEGER K;
	DW ← -DW;
	DQ ← -DQ;
	FOR K←1 THRU 2 DO
	⊂ DF ← -DF;DK ← -DK;
	 FOR I←1 THRU 5 DO
	 ⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
	   TRANSL(-MAN,0,DF,.47);ROTATE(-RL,DK,0,0);
	   ROTATE(-HD,0,-DW,0);ROTATE(-LL,-DK,0,0);
	   ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);PULP;⊃;
	 LC ← INCHRS;
	 IF LC≥0 THEN BEGIN
	  IF K=1 THEN ⊂ ARMS;RETURN;⊃;
	  DW ← -DW;DQ ← -DQ;DF ← -DF;DK ← -DK;
	  FOR I←1 THRU 5 DO
	  ⊂ ROTATE(-RT,-DW,0,0);ROTATE(-LT,-DW,0,0);
	    ROTATE(-RL,DK,0,0);ROTATE(-LL,-DK,0,0);
	    ROTATE(-LS,DQ,0,0);ROTATE(-RS,DQ,0,0);
	    ROTATE(-HD,0,-DW,0);TRANSL(-MAN,0,DF,.47);PULP;⊃;
	 ARMS;RETURN;⊃;
	END;
END "FOREVER";
END "STAR";
END "WALK";
SUBR FALL;
BEGIN "FALL"
	INTEGER L,K;
	REAL DW,DN;
	DW ← π*20/180;
	DN ← -.5;
	FOR K←1 THRU 2 DO
	⊂ FOR L←1 THRU 10 DO
	  ⊂ ROTATE(-MAN,0,0,DW);TRANSL(-MAN,DN,0,0);
	    TRANSL(MAN,0,DN,0);GEODPY;⊃;
	  FOR L←1 THRU 14 DO
	  ⊂ TRANSL(MAN,0,DN,0);GEODPY;⊃;
	  DW ← -DW;DN ← -DN;
	END;
	RETURN;
END "FALL";
SUBR WAVE;
BEGIN "WAVE"
	INTEGER I,L,K;
	REAL DH,BN;
	DH ← π/12;
	BN ← π/8;
	ARMS;
	FOR I←1 THRU 4 DO
	⊂ ROTATE(-RS,0,0,-BN);
	  ROTATE(-RA,0,0,-BN);PULP;⊃;
	WHILE TRUE DO
BEGIN "HII"
	 FOR L←1 THRU 2 DO
	 ⊂ DH ← -DH;
	  FOR I←1 THRU 2 DO
	  ⊂ DH ← -DH;
	   FOR K←1 THRU 2 DO
	   ⊂ ROTATE(-RA,-DH,0,0);PULP;⊃;⊃;⊃;
	LC ← INCHRS;
	IF LC≥0 THEN BEGIN
	 FOR I←1 THRU 4 DO
	 ⊂ ROTATE(-RA,0,0,BN);
	   ROTATE(-RS,0,0,BN);PULP;⊃;
	 ARMS;
	 RETURN;
	END;
END "HII";
END "WAVE";
SUBR DECA;
BEGIN "DECA"
	INTEGER K,I;
	REAL DC;
	DC ← π/8;
	FOR K←1 THRU 2 DO
	⊂ ROTATE(-RA,-DC,0,0);ROTATE(-LA,DC,0,0);PULP;⊃;
	DC ← -DC;
	FOR K←1 THRU 4 DO
	⊂ ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);PULP;⊃;
	ARMS;
	FOR K←1 THRU 2 DO
	⊂ ROTATE(-RH,0,0,-DG);ROTATE(-LH,0,0,DG);
	  ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,DG);PULP;⊃;
	DG ← DG*2;
	DC ← -DC;
	BATT(HD,RH);
	  FOR I←1 THRU 4 DO
	  ⊂ ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,-DG);
	    ROTATE(-RA,-DC,0,0);ROTATE(-LA,-DC,0,0);
	    ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,DG);PULP;⊃;
	BEND(DOWN);
	DG ← DG/2;
	FOR K←1 THRU 2 DO
	⊂ ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,-DG);
	  ROTATE(-RA,-DC,0,0);ROTATE(-LA,-DC,0,0);
	  ROTATE(-RA,0,0,-DG);ROTATE(-LA,0,0,DG);PULP;⊃;
	BEND(DOWN);BEND(DOWN);BDET(HD);
	FOR K←1 THRU 2 DO
	⊂ ROTATE(-RA,0,0,DG);ROTATE(-LA,0,0,-DG);
	  TRANSL(HD,0,-.3,0);
	  ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);
	  ROTATE(-RH,0,0,DG);ROTATE(-LH,0,0,-DG);PULP;⊃;
	BEND(UP);BEND(UP);
	FOR K←1 THRU 2 DO
	⊂ ROTATE(-RS,DC,0,0);ROTATE(-LS,DC,0,0);PULP;⊃;
	BEND(UP);BM ← -BM;
	RETURN;
END "DECA";
SUBR COMND;
BEGIN "COMND"
	INTEGER I;
	DG ← π/16;
	TA ← π/24;
	DB ← π/16;
	BA ← .06;
	DOWN ← -1;
	UP ← 1;
	RB ← -.01;
	RN ← π/16;
	BM ← π/8;
	IP ← 0;
	LP ← 1;
	IF LC="P" THEN ⊂ IP ← 1;LP ← -1;⊃;
WHILE TRUE DO
BEGIN "FIGER"
	LC ← INCHRW;
	IF LC="G" THEN GEOMED;
	IF LC="T" THEN ROND;
	IF LC="R" THEN WALK;
	IF LC="N" THEN NOD;
	IF LC="W" THEN WAVE;
	IF LC="F" THEN FALL;
	IF LC="D" THEN DECA;
	IF LC="A" THEN ARMS;
	IF LC="B" THEN BEND(DOWN);
	IF LC="U" THEN BEND(UP);
	IF LC="P" THEN LP ← -LP;
END "FIGER";
END "COMND";

α MAIN EXECUTION;
	OUTSTR(12&12&12&12&12);
	INIT;
	COMND;

END "SLAVE";